home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Snippets / SFGetFolderP / sample.p < prev    next >
Encoding:
Text File  |  1993-01-11  |  3.5 KB  |  78 lines  |  [TEXT/PJMM]
  1. program StandardGetFolder;
  2.  
  3. {/*******************************************************************************}
  4. {* StandardGetFolder Sample Program                             by Ken Kirksey  *}
  5. {*                                                                              *}
  6. {*    This little program gives an example of how to use the standard get       *}
  7. {*    folder function.                                                          *}
  8. {*                                                                              *}
  9. {*     Requires:  System 7.0 or later.  ANSI & MacTraps libraries.              *}
  10. {*******************************************************************************/}
  11. { Converted to Pascal by Peter N Lewis <peter@cujo.curtin.edu.au> Dec 1992 }
  12.  
  13.     uses
  14.         StandardGetFolder;
  15.  
  16.     var
  17.         mySFReply: StandardFileReply;
  18.         where: Point;
  19.         iErr: OSErr;
  20.         myFSSpec: FSSpec;
  21.         buffer: Str255;
  22.         inOutCount: longInt;
  23.         testFile: integer;
  24.         oe: OSErr;
  25. begin
  26.     SetPt(where, 60, 60);
  27.  
  28.     {/*-------------------------------------------------------------------------+}
  29.     {| Call Standard get folder, passing the point you want it to be drawn at,  |}
  30.     {| the message you want to be displayed above the file list, and a pointer  |}
  31.     {| to a StandardFileReply record.                                           |}
  32.     {+-------------------------------------------------------------------------*/}
  33.     StandardGetFolder(where, 'Home Free:', mySFReply);
  34.  
  35.     {/*-------------------------------------------------------------------------+}
  36.     {| Ok, the volume reference number and directory ID of the folder the user  |}
  37.     {| chose are returned in the sfFile field of the Standard File Reply.  Use  |}
  38.     {| use this information to build an FSSpec record that references the file  |}
  39.     {| you wish to create.                                                      |}
  40.     {+-------------------------------------------------------------------------*/}
  41.     iErr := FSMakeFSSpec(mySFReply.sfFile.vRefNum, mySFReply.sfFile.parID, 'MyFile.test', myFSSpec);
  42.     if iErr <> noErr then
  43.         writeln(iErr);
  44.  
  45.     {/*-------------------------------------------------------------------------+}
  46.     {| Now using the FSSpec record you made, create the file. I've got it set   |}
  47.     {| to create an Alpha (my favorite text editor) file. Change the creator    |}
  48.     {| code to suit your taste.                                                 |}
  49.     {+-------------------------------------------------------------------------*/}
  50.     iErr := FSpCreate(myFSSpec, 'ALFA', 'TEXT', mySFReply.sfScript);
  51.     if iErr <> noErr then
  52.         writeln(iErr);
  53.  
  54.     {/*-------------------------------------------------------------------------+}
  55.     {| Open the file and write a short message to it.                           |}
  56.     {+-------------------------------------------------------------------------*/}
  57.     iErr := FSpOpenDF(myFSSpec, fsRdWrPerm, testFile);
  58.     if iErr <> noErr then
  59.         writeln(iErr);
  60.  
  61.     iErr := SetEOF(testFile, 0);
  62.     if iErr <> noErr then
  63.         writeln(iErr);
  64.  
  65.     buffer := concat('Holey Smokes, It Worked!!!', chr(13));
  66.  
  67.     inOutCount := length(buffer);
  68.     iErr := FSWrite(testFile, inOutCount, @buffer[1]);
  69.     if iErr <> noErr then
  70.         writeln(iErr);
  71.  
  72.     {/*-------------------------------------------------------------------------+}
  73.     {| Close the file.                                                          |}
  74.     {+-------------------------------------------------------------------------*/}
  75.     iErr := FSClose(testFile);
  76.     if iErr <> noErr then
  77.         writeln(iErr);
  78. end.